home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / umich / tex / td187src.lzh / OBJECTUT.I < prev    next >
Text File  |  1991-12-14  |  48KB  |  1,506 lines
  1. IMPLEMENTATION MODULE ObjectUtilities;
  2. (*
  3.    Faßt ein paar häufiger benötigte Standardaufgaben im Zusammenhang
  4.    mit Zeichenobjekten zusammen, Redraw etc.
  5. *)
  6.  
  7. (* Import list *)
  8. IMPORT mtAppl;
  9. IMPORT Diverses;
  10. IMPORT MagicAES;
  11. IMPORT MagicVDI;
  12. IMPORT Bezier;
  13. IMPORT Circles;
  14. IMPORT Epic ;
  15. IMPORT Fill;
  16. IMPORT GetFile;
  17. IMPORT Lines;
  18. IMPORT MathLib0;
  19. IMPORT MagicStrings;
  20. IMPORT MagicSys;
  21. IMPORT TextBox;
  22. IMPORT WinUtils;
  23.  
  24. FROM CommonData      IMPORT WindowHandle, WindowTitle,
  25.                             ClipXY, OffsetXY, WorkArea,
  26.                             FileName, LineWidth, TextPosition,
  27.                             XPosx, XPosy, YPosx, YPosy,
  28.                             DXPosx, DXPosy, DYPosx, DYPosy,
  29.                             WholeArea, ZeroX, ZeroY,
  30.                             InternalResolution,
  31.                             SnapX, SnapY,
  32.                             FatherXOffset, FatherYOffset;
  33. FROM HelpModule      IMPORT LastHelpMessage, WinSize;
  34. FROM Types           IMPORT TextPosTyp, DrawObjectTyp, CodeAryTyp,
  35.                             ObjectSet, CharPtrTyp, ObjectPtrTyp,
  36.                             Block, ObjectRecTyp ;
  37. FROM SYSTEM          IMPORT ADR;
  38. FROM Variablen       IMPORT FirstObject, LastObject,
  39.                             NewObject, DeleteObject,
  40.                             PicToPix, PixToPic,
  41.                             ValueToStr, CoordToStr,
  42.                             PicDistance, PixDistance,
  43.                             Visible, MergeToSubpic,
  44.                             RefObject;
  45.  
  46. (**
  47. IMPORT RTD;
  48. **)
  49.  
  50. CONST ChangeBox = 2;
  51. (* global structures and variables **)
  52. TYPE CXYresproc  = PROCEDURE (VAR INTEGER, VAR INTEGER, VAR INTEGER,
  53.                               VAR INTEGER, VAR INTEGER,
  54.                               VAR INTEGER, VAR INTEGER);
  55.      LXYresproc  = PROCEDURE (VAR INTEGER, VAR INTEGER, VAR INTEGER,
  56.                               VAR INTEGER,
  57.                               VAR INTEGER, VAR INTEGER, VAR INTEGER);
  58.      Mirrorproc = PROCEDURE (VAR INTEGER, VAR INTEGER, VAR INTEGER,
  59.                              VAR INTEGER, VAR INTEGER, VAR INTEGER,
  60.                              VAR INTEGER, VAR INTEGER);
  61.      ShowObjProc     = PROCEDURE ( ObjectPtrTyp );
  62. VAR  ShowProcedures  : ARRAY DrawObjectTyp OF ShowObjProc;
  63.      ShowAllMode     : BOOLEAN;
  64.      Internal        : BOOLEAN;
  65. (**
  66.      ReallyAll       : BOOLEAN;
  67.      DrawSet         : ObjectSet;
  68. **)
  69.  
  70. (** zu Debug-Zwecken
  71.      ShowText        : ARRAY DrawObjectTyp OF ARRAY [0..15] OF CHAR;
  72. **)
  73.  
  74. PROCEDURE BeginStandardVDI;
  75. VAR dum : INTEGER;
  76. BEGIN
  77.   (* Setze jetzt die Standardwerte, damit die nicht *)
  78.   (* andauernd neu gesetzt werden müssen...         *)
  79.   dum := MagicVDI.SetLinetype ( mtAppl.VDIHandle , MagicVDI.Line ) ;
  80.   dum := MagicVDI.SetLinecolor ( mtAppl.VDIHandle , MagicAES.BLACK ) ;
  81.   dum := MagicVDI.SetMarkertype(mtAppl.VDIHandle, MagicVDI.Point);
  82.   dum := MagicVDI.SetMarkercolor(mtAppl.VDIHandle, MagicAES.BLACK);
  83.   MagicVDI.SetLineEndstyles ( mtAppl.VDIHandle ,
  84.                               MagicVDI.Cornerd , MagicVDI.Cornerd ) ;
  85.   dum := MagicVDI.SetFillinterior (mtAppl.VDIHandle , MagicVDI.Full ) ;
  86.   dum := MagicVDI.SetFillcolor ( mtAppl.VDIHandle , MagicAES.BLACK ) ;
  87. END BeginStandardVDI;
  88.  
  89. PROCEDURE EndStandardVDI;
  90. VAR dum : INTEGER;
  91. BEGIN
  92.   BeginStandardVDI;
  93. END EndStandardVDI;
  94.  
  95. (*
  96.    Jetzt die diversen Prozeduren zum Bestimmen der Schnittpunkte
  97.    der Linien mit einem umgebenden Kreis.
  98.    Alle gehen davon aus, daß der Mittelpunkt die Koordinaten 0,0 hat.
  99. *)
  100.  
  101. PROCEDURE CHorizRes(VAR y, RX, RY, X1, Y1, X2, Y2 : INTEGER);
  102. BEGIN
  103.   Y1 := y; Y2 := y;
  104.   X2 := Diverses.round(
  105.         MathLib0.sqrt(MathLib0.real(RX*RX) -
  106.         MathLib0.real(RX*RX)/MathLib0.real(RY*RY)*MathLib0.real(y*y)));
  107.   X1 := - X2;
  108. END CHorizRes;
  109.  
  110. PROCEDURE CVertiRes(VAR x, RX, RY, X1, Y1, X2, Y2 : INTEGER);
  111. BEGIN
  112.   X1 := x; X2 := x;
  113.   Y2 := Diverses.round(MathLib0.sqrt(MathLib0.real(RY*RY) -
  114.         MathLib0.real(RY*RY)/MathLib0.real(RX*RX)*MathLib0.real(x*x)));
  115.   Y1 := - Y2;
  116. END CVertiRes;
  117.  
  118. PROCEDURE CRightRes(VAR A, RX, RY, X1, Y1, X2, Y2 : INTEGER);
  119. VAR rx, ry, num, x1, x2, y1, y2, a : LONGREAL;
  120.     check : INTEGER;
  121. BEGIN
  122. (*
  123. Also wir benötigen die Schnittpunkte der Geraden:
  124.   y = x - a
  125. mit der Ellipsen:
  126.   y^2 / RY^2 + x^2/RX^2 = 1
  127. Also:
  128. =>  (x - a)^2 / RY^2 + x^2/RX^2 = 1
  129. =>  RX^2 x^2 - 2 RX^2 a x + RX^2 a^2 + RY^2 x^2 = RX^2 RY^2
  130. =>  (RX^2 + RY^2) x^2 - 2 RX^2 a x + RX^2 a^2 - RX^2 RY^2 = 0
  131. =>  x^2 - (2 RX^2 a)/(RX^2 + RY^2) x +
  132.           (RX^2 a^2 - RX^2 RY^2)/(RX^2 + RY^2) = 0
  133. => 2 reelle Lösungen für x:
  134.                                _______________________________________
  135.               RX^2 a          /    RX^4 a^2      RX^2 a^2 - RX^2 RY^2
  136.    x_1_2 = ----------- +- _  / --------------- - --------------------
  137.            RX^2 + RY^2     \/  (RX^2 + RY^2)^2      (RX^2 + RY^2)
  138. => läßt sich "vereinfachen" zu:
  139.                                                __________________
  140.                RX^2             RX RY         /
  141.    x_1_2 = ----------- a  +- -----------  _  /  RX^2 + RY^2 - a^2
  142.            RX^2 + RY^2       RX^2 + RY^2   \/
  143.  
  144. Im Falle eines Kreises (RX=RY=R) vereinfacht sich dieser Ausdruck zu:
  145.                              ___________
  146.             1   (           /            )
  147.    x_1_2 = --- (  a  +- _  /  R^2 - a^2   )
  148.             2   (        \/              )
  149. *)
  150.   rx  := MathLib0.real(RX);
  151.   ry  := MathLib0.real(RY);
  152.   a   := MathLib0.real(A);
  153.   IF (rx*rx + ry*ry - a*a) >=0.0 THEN
  154.     num := (rx * ry) / (rx*rx + ry*ry) * MathLib0.sqrt(rx*rx + ry*ry - a*a);
  155.     x1  := (a * rx*rx) / (rx*rx + ry*ry) - num;
  156.     y1  := MathLib0.sqrt ( ry*ry - (ry*ry) / (rx*rx) * x1 * x1 );
  157.     x2  := (a * rx*rx) / (rx*rx + ry*ry) + num;
  158.     X1   :=  Diverses.round( x1 );
  159.     X2   :=  Diverses.round( x2 );
  160.     Y1   := -Diverses.round( y1 );
  161.     Y2   := Y1 + (X2 - X1);
  162.     IF A = RX THEN
  163.       X1 :=  0; Y1 := -RY; X2 := RX; Y2 := 0;
  164.     END;
  165.  
  166.     (* Jetzt korrigiere eventuelle Ungenauigkeiten,
  167.        damit die Linien immer gleichen Abstand haben. *)
  168.     check := X1 - Y1;
  169.  
  170.     IF check<>A THEN
  171.       X1 := X1 + (A-check);
  172.       X2 := X2 + (A-check);
  173.     END;
  174.    ELSE
  175.     X1 := 0; Y1 := 0;
  176.     X2 := 0; Y2 := 0;
  177.   END;
  178. (**
  179.   RTD.ShowVar('x', A);
  180.   RTD.ShowVar('RX', RX);
  181.   RTD.ShowVar('RY', RY);
  182.   RTD.ShowVar('X1', X1);
  183.   RTD.ShowVar('Y1', Y1);
  184.   RTD.ShowVar('X2', X2);
  185.   RTD.ShowVar('Y2', Y2);
  186. **)
  187. END CRightRes;
  188.  
  189. PROCEDURE CLeftRes(VAR x, RX, RY, X1, Y1, X2, Y2 : INTEGER);
  190. VAR i, j, k, l : INTEGER;
  191. BEGIN
  192.   CRightRes(x, RX, RY, i, j, k, l);
  193.   X1 := -k;
  194.   Y1 := l;
  195.   X2 := -i;
  196.   Y2 := j;
  197. END CLeftRes;
  198.  
  199. PROCEDURE CHorizMirror(VAR X1, Y1, X2, Y2, X3, Y3, X4, Y4 : INTEGER);
  200. BEGIN
  201.   X3 := X1;  X4 :=  X2;
  202.   Y3 := -Y1; Y4 := -Y2;
  203. END CHorizMirror;
  204.  
  205. PROCEDURE CVertiMirror(VAR X1, Y1, X2, Y2, X3, Y3, X4, Y4 : INTEGER);
  206. BEGIN
  207.   X3 := -X1;  X4 := -X2;
  208.   Y3 :=  Y1;  Y4 := Y2;
  209. END CVertiMirror;
  210.  
  211. PROCEDURE CLeftRightMirror(VAR X1, Y1, X2, Y2, X3, Y3, X4, Y4 : INTEGER);
  212. BEGIN
  213.   X4 := -X1;  Y4 := -Y1;
  214.   X3 := -X2;  Y3 := -Y2;
  215. END CLeftRightMirror;
  216.  
  217. (*
  218.    Jetzt die diversen Prozeduren zum Bestimmen der Schnittpunkte
  219.    der Linien mit einem umgebenden Rechteck.
  220.    Alle gehen davon aus, daß der Mittelpunkt die Koordinaten 0,0 hat.
  221. *)
  222.  
  223. PROCEDURE LHorizRes(VAR x, W, H, X1, Y1, X2, Y2 : INTEGER);
  224. BEGIN
  225.   X1 := 0; X2 := W;
  226.   Y1 := x; Y2 := x;
  227. END LHorizRes;
  228.  
  229. PROCEDURE LVertiRes(VAR x, W, H, X1, Y1, X2, Y2 : INTEGER);
  230. BEGIN
  231.   X1 := x; X2 := x;
  232.   Y1 := 0; Y2 := H;
  233. END LVertiRes;
  234.  
  235. PROCEDURE LLeftRes(VAR x, W, H, X1, Y1, X2, Y2 : INTEGER);
  236. BEGIN
  237.   (* Jetzt wird's schon komplizierter *)
  238.   X1 := 0;
  239.   Y1 := x;
  240.   X2 := x;
  241.   Y2 := 0;
  242.   IF Y1>H THEN
  243.     X1 := x-H;
  244.     Y1 := H;
  245.   END;
  246.   IF (X2>W) THEN
  247.     X2 := W;
  248.     Y2 := x-W;
  249.   END;
  250. END LLeftRes;
  251.  
  252. PROCEDURE LRightRes(VAR x, W, H, X1, Y1, X2, Y2 : INTEGER);
  253. BEGIN
  254.   (* Jetzt wird's schon komplizierter *)
  255.   X1 := x;
  256.   Y1 := 0;
  257.   X2 := H + x;
  258.   Y2 := H;
  259.   IF X1<0 THEN
  260.     X1 :=  0;
  261.     Y1 := -x;
  262.   END;
  263.   IF (X2>W) THEN
  264.     X2